Simulador Montecarlo 2023

Importação de pacotes necessários e funções personalizadas

Além dos pacotes necessários, as funções são necessárias para calcular o resultado final de cada jogo, a quantidade final de pontos de cada equipe e também montar uma tabela de classificação de acordo com um conjunto de placares.

# Pacotes necessários
library(tidyverse)
library(goalmodel)
library(worldfootballR)
library(regista)
library(janitor)
library(magrittr)
library(ggrepel)
library(ggtext)
library(jsonlite)
library(gt)
library(gtExtras)
library(MetBrewer)

# Funções para calcular o resultado da partida
calcV <- function(hg, ag){
  return(hg > ag)
}
calcD <- function(hg, ag){
  return(hg < ag)
}
calcE <- function(hg, ag){
  return(hg == ag)
}
calcPTS <- function(hg, ag){
  return(ifelse(hg < ag, 0, ifelse(hg == ag, 1, 3)))
}
calcTAB <- function(games){
  home <- games %>%
    mutate(casa_V = calcV(hgoal, agoal),
           casa_E = calcE(hgoal, agoal),
           casa_D = calcD(hgoal, agoal),
           casa_PTS = calcPTS(hgoal,agoal)) %>%
    group_by(home) %>% summarise(casa_PTS = sum(casa_PTS),
                                 casa_J = length(home),
                                 casa_V = sum(casa_V),
                                 casa_E = sum(casa_E),
                                 casa_D = sum(casa_D),
                                 casa_GP = sum(as.numeric(hgoal)),
                                 casa_GS = sum(as.numeric(agoal)),
                                 casa_SG = sum(as.numeric(hgoal)) - sum(as.numeric(agoal))) %>%
    dplyr::rename(Time = home)
  
  away <- games %>%
    mutate(fora_V = calcV(agoal, hgoal),
           fora_E = calcE(agoal, hgoal),
           fora_D = calcD(agoal, hgoal),
           fora_PTS = calcPTS(agoal,hgoal)) %>%
    group_by(away) %>% summarise(fora_PTS = sum(fora_PTS),
                                 fora_J = length(away),
                                 fora_V = sum(fora_V),
                                 fora_E = sum(fora_E),
                                 fora_D = sum(fora_D),
                                 fora_GP = sum(as.numeric(agoal)),
                                 fora_GS = sum(as.numeric(hgoal)),
                                 fora_SG = sum(as.numeric(agoal)) - sum(as.numeric(hgoal))) %>%
    dplyr::rename(Time = away)
  
  total <- inner_join(home, away, by = 'Time') %>%
    mutate(PTS = casa_PTS + fora_PTS,
           J = casa_J + fora_J,
           V = casa_V + fora_V,
           E = casa_E + fora_E,
           D = casa_D + fora_D,
           GP = casa_GP + fora_GP,
           GS = casa_GS + fora_GS,
           SG = casa_SG + fora_SG) %>%
    select(Time, PTS, J, V, E, D, GP, GS, SG) %>%
    arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
    mutate(Pos = row_number()) %>%
    relocate(Pos) %>%
    mutate(AP = round(PTS / (J * 3) * 100, digits = 1))
  
  return(total)
}

current_date <- strftime(Sys.Date(), format = "%d-%m-%Y")
camcorder::gg_record(
  dir = file.path(here::here("camcorder_outputs")),
  device = "png",
  width = 18,
  height = 10,
  dpi = 300)
sysfonts::font_add_google(name = "IBM Plex Sans", family = "IBM")
showtext::showtext_auto()
showtext::showtext_opts(dpi = 300)
font <- "IBM"

Extração e manipulação dos dados necessários para o modelo

Os dados utilizados são originários do site FBRef e para tentar aumentar a eficácia do modelo coletaremos todos os placares dos jogos do Campeonato Brasileiro desde 2014. Os jogos já disputados em 2023, obviamente, serão integrados à parte de treinamento de modelo, que será então aplicado aos jogos ainda por disputar.

Na data da elaboração original desse modelo, no dia 17 de agosto, o Campeonato Brasileiro acabava de chegar ao final do seu primeiro turno, tendo o Botafogo como líder incontestável. Com 47 pontos nas 19 partidas disputadas no primeiro turno, o Botafogo igualava em pontos o desempenho do Corinthians na primeira metade de 2017. O primeiro critério de desempate de acordo com o regulamento do campeonato, o número de vitórias, deu ao Botafogo o melhor primeiro turno da história: foram 15 vitórias contra 14 do Corinthians em 2017, que também fez história ao fechar de maneira invicta a sequência de 19 jogos.

folder <- "C:/R/Simuladores BR 2023/"
# Dataframe vazio para armazenar todas tabelas finais
montecarlo_tabelas <- setNames(data.frame(matrix(ncol = 12, nrow = 0)),
                               c('Pos', 'Time', 'PTS', 'J', 'V', 'E',
                                 'D', 'GP', 'GS', 'SG', 'AP', 'sim'))
# Lista de dataframes
montecarlo_tabelas_df <- list()

# Dataframe vazio para armazenar todos os jogos
montecarlo_jogos <- setNames(data.frame(matrix(ncol = 10, nrow = 0)),
                             c('year', 'home', 'hgoal', 'agoal', 'away',
                               'p1', 'pX', 'p2', 'hxg', 'axg'))
# Lista de dataframes
montecarlo_jogos_df <- list()

# Extraindo dados do Campeonato Brasileiro de 2023 do FBRef
data_2023 <- fb_match_results(country = "BRA",
                              gender = "M",
                              season_end_year = 2023,
                              tier = "1st") %>%
  clean_names() %>% factor_teams(c("home", "away")) %>% 
  rename(hgoal = home_goals, agoal = away_goals) %>% 
  select('date', 'home', 'away', 'hgoal', 'agoal')

# Lista de times
times <- unique(data_2023$home)

# Extraindo dados das outras edições disponíveis no FBRef
# Esses jogos servirão como treinamento do modelo
train_data <- fb_match_results(country = "BRA",
                               gender = "M",
                               season_end_year = c(2014,2015,2016,
                                                   2017,2018,2019,
                                                   2020,2021,2022),
                               tier = "1st") %>%
  clean_names() %>% factor_teams(c("home", "away")) %>% 
  rename(hgoal = home_goals, agoal = away_goals) %>% 
  select('date', 'home', 'away', 'hgoal', 'agoal')

# Separando os jogos já disputados em 2023
# Esses jogos farão parte do treinamento do modelo
played_2023 <- data_2023 %>% filter(!is.na(hgoal) & !is.na(agoal))
train_data <- rbind(train_data, played_2023)

# Separando os jogos ainda não disputados de 2023
# Esses jogos serão o teste do modelo
test_data <- data_2023 %>% filter(is.na(hgoal) & is.na(agoal))

# Criando um dataframe para todos os jogos desde 2014
full_data <- rbind(train_data, test_data)

Criação e visualização do modelo

Nessa visualização do modelo, o sumário mostrará todos os times presentes nos dados fornecidos ao modelo. Isso significa que todos os clubes participantes de ao menos uma edição do Campeonato Brasileiro desde 2014 estarão presentes.

pesos <- weights_dc(train_data$date, xi = 0.003)
model <- goalmodel(goals1 = train_data$hgoal,
                   goals2 = train_data$agoal,
                   team1 = train_data$home,
                   team2 = train_data$away,
                   dc = TRUE,
                   rs = TRUE,
                   model = 'poisson',
                   weights = pesos)
summary(model)

## Model sucsessfully fitted in 17.71 seconds
## 
## Number of matches          3618 
## Number of teams              34 
## 
## Model                     Poisson 
## 
## Log Likelihood            -952.77 
## AIC                        2045.54 
## R-squared                  0.12 
## Parameters (estimated)       70 
## Parameters (fixed)            0 
## 
## Team                      Attack   Defense
## América (MG)              0.12    -0.20 
## Ath Paranaense             0.22     0.02 
## Atl Goianiense             0.00    -0.04 
## Atlético Mineiro          0.12     0.24 
## Avaí                     -0.10    -0.15 
## Bahia                      0.10     0.01 
## Botafogo (RJ)              0.22     0.31 
## Bragantino                 0.22    -0.03 
## Ceará                    -0.08     0.15 
## Chapecoense               -0.25    -0.20 
## Corinthians                0.07     0.16 
## Coritiba                   0.06    -0.25 
## Criciúma                 -0.28    -0.19 
## Cruzeiro                  -0.11     0.36 
## CSA                       -0.30    -0.11 
## Cuiabá                   -0.07     0.15 
## Figueirense               -0.24    -0.04 
## Flamengo                   0.42    -0.01 
## Fluminense                 0.26     0.12 
## Fortaleza                  0.08     0.18 
## Goiás                     0.02    -0.07 
## Grêmio                    0.31    -0.07 
## Internacional              0.09     0.17 
## Joinville                 -0.43    -0.07 
## Juventude                 -0.15    -0.18 
## Palmeiras                  0.39     0.26 
## Paraná                   -0.65    -0.03 
## Ponte Preta               -0.02    -0.07 
## Santa Cruz                 0.15    -0.40 
## Santos                     0.08    -0.07 
## São Paulo                 0.14     0.17 
## Sport Recife              -0.33     0.19 
## Vasco da Gama             -0.14    -0.07 
## Vitória                   0.08    -0.22 
## -------
## Intercept                 -0.12 
## Home field advantage       0.36 
## Dixon-Coles adj. (rho)    -0.01 
## Rue-Salvesen adj. (gamma) -0.43

Plotagem das variáveis de cada time do Campeonato Brasileiro de 2023

coef <- as.data.frame(model[["parameters"]][["attack"]])
coef$Def <- model[["parameters"]][["defense"]]
colnames(coef)[1] <- 'Att'
coef$Ovr <- coef$Att + coef$Def
coef <- coef[,c(3,1,2)]
coef$Time <- row.names(coef)
coef <- coef %>% filter(`Time` %in% times)

coefplot <- coef %>% ggplot(aes(x = Def, y = Att)) +
  geom_point(shape=21, stroke=0, fill="orange", color = "black", size=8) +
  #geom_text_repel(aes(label = team)) +
  #geom_text(aes(label = Time), position = position_nudge(y = -0.06)) +
  geom_text(aes(label = Time), hjust = -0.2, size = 5) +
  theme_minimal(base_size = 20) +
  labs(title = "Estimativa de parâmetros dos times",
       y = "Ataque",
       x = "Defesa")

print(coefplot)
ggsave(paste(folder,
             current_date,
             ' - Coeficientes.png',
             sep = ''),
       plot = coefplot)

## Saving 7 x 5 in image

Definindo a quantidade de simulações e executando

Cada iteração produz uma tabela de classificação final do campeonato, após todos clubes terem disputado suas 38 partidas, e uma lista dos 380 placares dos jogos entre as equipes. Todas essas tabelas e listas de jogos são agrupadas a um conjunto único, por motivos que serão explicados a seguir.

# Quantidade de simulações
runs = 10000

for(n in 1:runs){
  run <- test_data

  for(i in 1:nrow(run)){
    plac <- predict_goals(
      model,
      team1 = run$home[i],
      team2 = run$away[i],
      return_df = TRUE,
      maxgoal = 15)
    plac$res <- paste(plac$goals1,plac$goals2,sep="x")
    plac <- plac[c(1,2,5,6)]
    plac$probability <- ifelse(plac$probability < 0,
                               abs(plac$probability), plac$probability)
    
    match <- sample(plac$res, 1, prob = plac$probability)
    match <- data.frame(test_data$date[i], test_data$home[i],
                        test_data$away[i], match)
    colnames(match) <- c('date', 'home', 'away', 'x')
    match[c('hgoal', 'agoal')] <- str_split_fixed(match$x, 'x', 2)
    match$x <- 'x'
    match <- match[c(1,2,5,6,3)]
    run <- rbind(run,match)
  }
  
  run <- run %>% drop_na(hgoal)
  simmed <- run %>% select(1,2,3,4,5)
  total <- rbind(played_2023, simmed)
  
  classificacao_casa <- total %>%
    mutate(casa_V = calcV(hgoal, agoal),
           casa_E = calcE(hgoal, agoal),
           casa_D = calcD(hgoal, agoal),
           casa_PTS = calcPTS(hgoal,agoal)) %>%
    group_by(home) %>% summarise(casa_PTS = sum(casa_PTS),
                                 casa_J = length(home),
                                 casa_V = sum(casa_V),
                                 casa_E = sum(casa_E),
                                 casa_D = sum(casa_D),
                                 casa_GP = sum(as.numeric(hgoal)),
                                 casa_GS = sum(as.numeric(agoal)),
                                 casa_SG = sum(as.numeric(hgoal)) - sum(as.numeric(agoal))) %>%
    dplyr::rename(Time = home)
  
  classificacao_fora <- total %>%
    mutate(fora_V = calcV(agoal, hgoal),
           fora_E = calcE(agoal, hgoal),
           fora_D = calcD(agoal, hgoal),
           fora_PTS = calcPTS(agoal,hgoal)) %>%
    group_by(away) %>% summarise(fora_PTS = sum(fora_PTS),
                                 fora_J = length(away),
                                 fora_V = sum(fora_V),
                                 fora_E = sum(fora_E),
                                 fora_D = sum(fora_D),
                                 fora_GP = sum(as.numeric(agoal)),
                                 fora_GS = sum(as.numeric(hgoal)),
                                 fora_SG = sum(as.numeric(agoal)) - sum(as.numeric(hgoal))) %>%
    dplyr::rename(Time = away)
  
  classificacao_final <- inner_join(classificacao_casa, classificacao_fora, by = 'Time') %>%
    mutate(PTS = casa_PTS + fora_PTS,
           J = casa_J + fora_J,
           V = casa_V + fora_V,
           E = casa_E + fora_E,
           D = casa_D + fora_D,
           GP = casa_GP + fora_GP,
           GS = casa_GS + fora_GS,
           SG = casa_SG + fora_SG) %>%
    select(Time, PTS, J, V, E, D, GP, GS, SG) %>%
    arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
    mutate(Pos = row_number()) %>%
    relocate(Pos) %>%
    mutate(AP = round(PTS / (J * 3) * 100, digits = 1)) %>%
    mutate(sim = n)
  
  montecarlo_tabelas <- do.call(rbind, list(montecarlo_tabelas, classificacao_final))
  montecarlo_tabelas_df <- c(montecarlo_tabelas_df, list(classificacao_final))
  run <- run %>% mutate(sim = n)
  montecarlo_jogos <- do.call(rbind, list(montecarlo_jogos, run))
  montecarlo_jogos_df <- c(montecarlo_jogos_df, list(run))
}

Criando um dataframe médio pelas tabelas

Usando a lista de dataframes de tabelas de classificação anteriormente criado, será gerado um dataframe médio que permitirá aplicação de métodos de distância euclidiana. Após isso, cada tabela de classificação é comparada ao dataframe médio e uma distância euclidiana é calculada. Quanto maior essa distância, maior a diferença entre a iteração e o resultado médio.

Após todas as iterações serem avaliadas, é criado um dataframe distances_df listando o número de cada iteração e sua distância euclidiana com relação ao dataframe médio. Esse dataframe distances_df também possui uma coluna de probabilidade. Quanto mais próximo do dataframe médio, maior o valor da probabilidade. Essa coluna pode então ser usada em uma função sample com peso que nos permite sortear uma iteração X e conferir como ficou a tabela final de tal iteração.

# Calculate the average dataframe
if (!all(sapply(montecarlo_tabelas_df, function(df) identical(dim(df), dim(montecarlo_tabelas_df[[1]]))))) {
  stop("All dataframes must have the same dimensions.")
}
preprocess_dataframe <- function(df) {
  df_numeric <- as.data.frame(lapply(df, function(col) as.numeric(as.character(col))))
  return(df_numeric)
}
list_of_dataframes_numeric <- lapply(montecarlo_tabelas_df, preprocess_dataframe)
all_data <- array(unlist(list_of_dataframes_numeric), dim = c(nrow(list_of_dataframes_numeric[[1]]), ncol(list_of_dataframes_numeric[[1]]), length(list_of_dataframes_numeric)))
average_dataframe <- apply(all_data, c(1, 2), mean)
distances <- apply(all_data, 3, function(df) dist(rbind(df, average_dataframe))[1])
distances_vector <- unlist(distances)
distances_df <- data.frame(Index = seq_along(distances_vector), Distance = distances_vector)
distances_df <- distances_df %>%
  arrange(desc(Distance)) %>%
  mutate(prob = Distance / sum(Distance))
distances_df$prob <- distances_df$prob / sum(distances_df$prob)

head(select(distances_df, -2), n = 10)

##    Index         prob
## 1   8685 0.0003159649
## 2   7827 0.0002918119
## 3   6053 0.0002771370
## 4    173 0.0002761866
## 5   4588 0.0002736116
## 6   2495 0.0002634401
## 7   4055 0.0002610712
## 8   3055 0.0002602416
## 9   1735 0.0002584570
## 10  3224 0.0002564675

Montagem da tabela final do método Montecarlo

Diferentemente da etapa anterior, onde o foco era só analisar matematicamente quão próximos eram os dataframes entre si, o objetivo aqui é criar a tabela final de classificação do campeonato. Resumindo, os totais de pontos, gols, vitórias, empates e derrotas de cada clube são divididos pela quantidade de iteração e organizados seguindo os critérios de desempate da competição.

# Montar classificação média
classificacao_media <- montecarlo_tabelas %>% group_by(Time) %>%
  summarise(PTS = round(mean(PTS)),
            J = round(mean(J)),
            V = round(mean(V)),
            E = round(mean(E)),
            D = round(mean(D)),
            GP = round(mean(GP)),
            GS = round(mean(GS)),
            SG = round(mean(SG))) %>%
  arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
  mutate(Pos = row_number()) %>%
  relocate(Pos)

head(classificacao_media, n = 8)

## # A tibble: 8 × 10
##     Pos Time               PTS     J     V     E     D    GP    GS    SG
##   <int> <fct>            <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     1 Botafogo (RJ)       80    38    24     8     6    60    26    34
## 2     2 Palmeiras           72    38    20    11     7    68    32    35
## 3     3 Flamengo            65    38    19     9    10    63    47    16
## 4     4 Fluminense          62    38    18     9    12    52    40    12
## 5     5 Grêmio              60    38    17     8    13    55    50     5
## 6     6 Ath Paranaense      57    38    16    10    12    52    45     7
## 7     7 Bragantino          56    38    15    13    11    50    44     6
## 8     8 Atlético Mineiro    55    38    15    11    12    44    35     9

Correção e padronização do nome de equipes

A seguir, utilizaremos outro site para obter os escudos de cada equipe. Alguns times estão nomeados diferentes nas duas fontes, então precisamos fazer algumas modificações nos dados.

classificacao_media$Time <- as.character(classificacao_media$Time)
classificacao_media[classificacao_media == 'Ath Paranaense'] <- 'Athletico'
classificacao_media[classificacao_media == 'Botafogo (RJ)'] <- 'Botafogo'
classificacao_media[classificacao_media == 'Bragantino'] <- 'RB Bragantino'

Probabilidades de término por clube e posição

Novamente usando a lista de dataframes anteriormente estabelecidas, criaremos uma visualização mostrando em porcentagem quantas vezes cada clube terminou em cada uma das 20 posições. Isso pode, portanto, ser considerado a probabilidade de cada clube terminar em cada posição. Ao menos de acordo com a capacidade de previsão do nosso modelo, com resultado a ser conferido ao término do campeonato de fato.

resumo <- montecarlo_tabelas %>%
  group_by(Pos, Time) %>%
  tally(name = "Total") %>%
  mutate(prob = Total / runs)

resumo$Time <- as.character(resumo$Time)
resumo[resumo == 'Ath Paranaense'] <- 'Athletico'
resumo[resumo == 'Botafogo (RJ)'] <- 'Botafogo'
resumo[resumo == 'Bragantino'] <- 'RB Bragantino'

resumoplot <- resumo %>%
  ggplot(aes(x = Pos,
             y = fct_reorder(Time,-Pos),
             fill = prob)) +
  geom_tile() +
  scale_x_continuous(breaks = seq(0, 24, 1),
                     expand = c(0.03, 0)) +
  scale_fill_continuous(low = "white", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob * 100, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Probabilidade por posição no Campeonato Brasileiro 2023',
       subtitle = gt::md(glue::glue("Simulado em {current_date}")),
       y = "",
       x = "Posição") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12)) 

qtd_times <- classificacao_media %>% pull(Time) %>% n_distinct()
print(resumoplot)
ggsave(paste(folder, current_date, ' - Posições.png', sep = ''),
       plot = resumoplot, width = 18, height = 10)

Probabilidades de resultado por clube

resumo_zonas <- resumo %>%
  mutate(Zona = case_when(
    Pos >= 1 & Pos <= 6 ~ "Libertadores",
    Pos >= 7 & Pos <= 12 ~ "Sulamericana",
    Pos >= 17 & Pos <= 20 ~ "Rebaixamento",
    TRUE ~ "Outro")) %>%
  group_by(Zona, Time) %>%
  summarise(Count = sum(Total)) %>%
  mutate(prob = Count / runs * 100) %>%
  arrange(desc(Count))

resumo_lib <- resumo_zonas %>%
  subset(Zona == "Libertadores") %>%
  select(2, 4)

resumo_sula <- resumo_zonas %>%
  subset(Zona == "Sulamericana") %>%
  select(2, 4)

resumo_reb <- resumo_zonas %>%
  subset(Zona == "Rebaixamento") %>%
  select(2, 4)

Chances de Libertadores

resumo_lib_plot <- resumo_lib %>%
  arrange(desc(prob)) %>%
  ggplot(aes(x = Zona,
             y = fct_reorder(Time,prob),
             fill = prob)) +
  geom_tile() +
  scale_fill_continuous(low = "pink", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Chances de Libertadores',
       y = "",
       x = "") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12),
        plot.margin = margin(10, 1000, 1, 10, "pt"))

head(resumo_lib, n = 20)

## # A tibble: 17 × 3
## # Groups:   Zona [1]
##    Zona         Time               prob
##    <chr>        <chr>             <dbl>
##  1 Libertadores Botafogo         100   
##  2 Libertadores Palmeiras         99.4 
##  3 Libertadores Flamengo          89.6 
##  4 Libertadores Fluminense        73.2 
##  5 Libertadores Grêmio            60.6 
##  6 Libertadores Athletico         43.5 
##  7 Libertadores RB Bragantino     32.6 
##  8 Libertadores Atlético Mineiro  24.8 
##  9 Libertadores Fortaleza         23.7 
## 10 Libertadores São Paulo         23.4 
## 11 Libertadores Corinthians       10.6 
## 12 Libertadores Cuiabá             6.9 
## 13 Libertadores Internacional      5.95
## 14 Libertadores Cruzeiro           5.24
## 15 Libertadores Bahia              0.35
## 16 Libertadores Goiás              0.17
## 17 Libertadores Santos             0.12

Chances de Sulamericana

resumo_sula_plot <- resumo_sula %>%
  arrange(desc(prob)) %>%
  ggplot(aes(x = Zona,
             y = fct_reorder(Time,prob),
             fill = prob)) +
  geom_tile() +
  scale_fill_continuous(low = "pink", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Chances de Sulamericana',
       y = "",
       x = "") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12),
        plot.margin = margin(10, 1000, 1, 10, "pt"))

head(resumo_sula, n = 20)

## # A tibble: 19 × 3
## # Groups:   Zona [1]
##    Zona         Time              prob
##    <chr>        <chr>            <dbl>
##  1 Sulamericana Fortaleza        61.4 
##  2 Sulamericana Atlético Mineiro 60.4 
##  3 Sulamericana São Paulo        60.2 
##  4 Sulamericana RB Bragantino    57.7 
##  5 Sulamericana Corinthians      56.0 
##  6 Sulamericana Cuiabá           53.4 
##  7 Sulamericana Athletico        51.1 
##  8 Sulamericana Internacional    49.2 
##  9 Sulamericana Cruzeiro         46.5 
## 10 Sulamericana Grêmio           36.8 
## 11 Sulamericana Fluminense       25.6 
## 12 Sulamericana Bahia            14.3 
## 13 Sulamericana Flamengo         10.2 
## 14 Sulamericana Goiás             9.87
## 15 Sulamericana Santos            6.3 
## 16 Sulamericana Palmeiras         0.6 
## 17 Sulamericana Vasco da Gama     0.25
## 18 Sulamericana América (MG)      0.11
## 19 Sulamericana Coritiba          0.03

Chances de rebaixamento

resumo_reb_plot <- resumo_reb %>%
  arrange(desc(prob)) %>%
  ggplot(aes(x = Zona,
             y = fct_reorder(Time,prob),
             fill = prob)) +
  geom_tile() +
  scale_fill_continuous(low = "pink", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Chances de Rebaixamento',
       y = "",
       x = "") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12),
        plot.margin = margin(10, 1000, 1, 10, "pt"))

head(resumo_reb, n = 20)

## # A tibble: 16 × 3
## # Groups:   Zona [1]
##    Zona         Time              prob
##    <chr>        <chr>            <dbl>
##  1 Rebaixamento Coritiba         96.9 
##  2 Rebaixamento América (MG)     96.1 
##  3 Rebaixamento Vasco da Gama    92.0 
##  4 Rebaixamento Santos           44.5 
##  5 Rebaixamento Goiás            32.2 
##  6 Rebaixamento Bahia            25.5 
##  7 Rebaixamento Cruzeiro          3.57
##  8 Rebaixamento Internacional     3.28
##  9 Rebaixamento Cuiabá            2.15
## 10 Rebaixamento Corinthians       2.12
## 11 Rebaixamento Atlético Mineiro  0.47
## 12 Rebaixamento São Paulo         0.44
## 13 Rebaixamento Fortaleza         0.38
## 14 Rebaixamento RB Bragantino     0.21
## 15 Rebaixamento Grêmio            0.06
## 16 Rebaixamento Athletico         0.03

Início da criação da tabela visual final

# Função simples de extração do escudo de cada time
logo_image <- function(team_id, width = 20) {
  glue::glue("https://images.fotmob.com/image_resources/logo/teamlogo/{team_id}.png")
}

# Logotipo do Campeonato Brasileiro
league_logo <- "https://images.fotmob.com/image_resources/logo/leaguelogo/268.png"

# Criação de uma tabela auxiliar com o nome de cada time
# e um link para o respectivo escudo
team_ids <- fotmob_get_league_tables(league_id = 268) %>%
  filter(table_idx == 1:20) %>% slice(1:20)
team_ids <- team_ids %>%
  mutate(image_link = logo_image(team_id = unique(team_ids$table_id))) %>%
  select(4, 19)
colnames(team_ids)[1] <- 'Time'

# Novamente correção e padronização do nome de equipes
# Essencial para o full join
team_ids[team_ids == "America MG"] <- "América (MG)"
team_ids[team_ids == "Athletico Paranaense"] <- 'Athletico'
team_ids[team_ids == "Atletico MG"] <- 'Atlético Mineiro'
team_ids[team_ids == "Cuiaba"] <- 'Cuiabá'
team_ids[team_ids == "Goias"] <- 'Goiás'
team_ids[team_ids == "Gremio"] <- 'Grêmio'
team_ids[team_ids == "Red Bull Bragantino"] <- 'RB Bragantino'
team_ids[team_ids == "Santos FC"] <- 'Santos'
team_ids[team_ids == "Sao Paulo"] <- 'São Paulo'

classificacao_media <- full_join(classificacao_media, team_ids, by = 'Time') %>%
  relocate(image_link, .after = Pos)

Calculando tabela de acordo com os jogos disputados até a data de hoje

table_today <- calcTAB(played_2023)
table_today <- table_today[, -ncol(table_today)]
table_today$Time <- as.character(table_today$Time)
table_today[table_today == 'Ath Paranaense'] <- 'Athletico'
table_today[table_today == 'Botafogo (RJ)'] <- 'Botafogo'
table_today[table_today == 'Bragantino'] <- 'RB Bragantino'
table_today <- full_join(table_today, team_ids, by = 'Time') %>%
  relocate(image_link, .after = Pos)

head(select(table_today, -2), n = 8)

## # A tibble: 8 × 10
##     Pos Time            PTS     J     V     E     D    GP    GS    SG
##   <int> <chr>         <dbl> <int> <int> <int> <int> <dbl> <dbl> <dbl>
## 1     1 Botafogo         48    20    15     3     2    35    11    24
## 2     2 Palmeiras        37    20    10     7     3    36    17    19
## 3     3 Flamengo         35    20    10     5     5    34    26     8
## 4     4 Fluminense       34    20    10     4     6    28    20     8
## 5     5 Grêmio           33    19    10     3     6    29    25     4
## 6     6 Athletico        32    20     9     5     6    29    23     6
## 7     7 RB Bragantino    32    20     8     8     4    27    21     6
## 8     8 Fortaleza        29    20     8     5     7    22    19     3

Plotagem final da tabela de classificação simulada

(
  sim <-
    classificacao_media %>%
    gt::gt()  |>
    ##logos
    gtExtras::gt_img_rows(column = image_link, height = 20) |>
    ##change column names
    gt::cols_label(image_link = "")  %>%
    ##apply 538 theme
    gtExtras::gt_theme_538()  %>%
    ##highlight rows for top 4/5/and bottom 3
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 1:4,
      fill = '#ACE1AF',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 5:6,
      fill = '#D0F0C0',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 7:12,
      fill = '#FFDEAD',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 17:20,
      fill = '#FFCCCC',
      font_weight = "normal"
    )  |>
    ##align text
    gt::cols_align("center")  |>
    gt::cols_align(align = 'left',
                   columns = Time)  |>
    gt::cols_width(Time ~ px(165))  |>
    gt::cols_width(PTS ~ px(35))  |>
    gt::cols_width(J ~ px(35))  |>
    gt::cols_width(V ~ px(35))  |>
    gt::cols_width(E ~ px(35))  |>
    gt::cols_width(D ~ px(35))  |>
    gt::cols_width(GP ~ px(35))  |>
    gt::cols_width(GS ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::tab_style(style = cell_text(weight = 'bold'),
                  locations  = cells_body(columns = c(PTS, Pos)))  |>
    ##format title and subtitle (including league logo)
    gt::tab_header(
      title = gt::md(
        glue::glue(
          "<img src='{league_logo}' style='height:60px;'><br>Brasileirão 2023"
        )
      ),
      subtitle = gt::md(glue::glue("Simulado em **{current_date}**"))
    ))

Brasileirão 2023
Simulado em 25-08-2023
Pos		Time	PTS	J	V	E	D	GP	GS	SG
1		Botafogo	80	38	24	8	6	60	26	34
2		Palmeiras	72	38	20	11	7	68	32	35
3		Flamengo	65	38	19	9	10	63	47	16
4		Fluminense	62	38	18	9	12	52	40	12
5		Grêmio	60	38	17	8	13	55	50	5
6		Athletico	57	38	16	10	12	52	45	7
7		RB Bragantino	56	38	15	13	11	50	44	6
8		Atlético Mineiro	55	38	15	11	12	44	35	9
9		Fortaleza	55	38	15	10	13	43	38	5
10		São Paulo	55	38	14	12	12	46	38	8
11		Corinthians	52	38	13	11	13	43	42	2
12		Cuiabá	50	38	14	9	15	38	43	-5
13		Internacional	50	38	13	11	14	38	43	-5
14		Cruzeiro	50	38	12	13	13	37	33	4
15		Bahia	44	38	11	11	16	42	48	-6
16		Goiás	42	38	11	10	17	37	54	-17
17		Santos	41	38	10	11	17	40	58	-18
18		Vasco da Gama	33	38	8	9	21	31	58	-27
19		América (MG)	31	38	7	9	22	41	74	-32
20		Coritiba	30	38	7	9	22	37	70	-33

Plotagem final da tabela de classificação atual

(
  act <-
    table_today %>%
    gt::gt()  |>
    ##logos
    gtExtras::gt_img_rows(column = image_link, height = 20) |>
    ##change column names
    gt::cols_label(image_link = "")  %>%
    ##apply 538 theme
    gtExtras::gt_theme_538()  %>%
    ##highlight rows for top 4/5/and bottom 3
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 1:4,
      fill = '#ACE1AF',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 5:6,
      fill = '#D0F0C0',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 7:12,
      fill = '#FFDEAD',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 17:20,
      fill = '#FFCCCC',
      font_weight = "normal"
    )  |>
    ##align text
    gt::cols_align("center")  |>
    gt::cols_align(align = 'left',
                   columns = Time)  |>
    gt::cols_width(Time ~ px(165))  |>
    gt::cols_width(PTS ~ px(35))  |>
    gt::cols_width(J ~ px(35))  |>
    gt::cols_width(V ~ px(35))  |>
    gt::cols_width(E ~ px(35))  |>
    gt::cols_width(D ~ px(35))  |>
    gt::cols_width(GP ~ px(35))  |>
    gt::cols_width(GS ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::tab_style(style = cell_text(weight = 'bold'),
                  locations  = cells_body(columns = c(PTS, Pos)))  |>
    ##format title and subtitle (including league logo)
    gt::tab_header(
      title = gt::md(
        glue::glue(
          "<img src='{league_logo}' style='height:60px;'><br>Brasileirão 2023"
        )
      ),
      subtitle = gt::md(glue::glue("Classificação em **{current_date}**"))
    ))

Brasileirão 2023
Classificação em 25-08-2023
Pos		Time	PTS	J	V	E	D	GP	GS	SG
1		Botafogo	48	20	15	3	2	35	11	24
2		Palmeiras	37	20	10	7	3	36	17	19
3		Flamengo	35	20	10	5	5	34	26	8
4		Fluminense	34	20	10	4	6	28	20	8
5		Grêmio	33	19	10	3	6	29	25	4
6		Athletico	32	20	9	5	6	29	23	6
7		RB Bragantino	32	20	8	8	4	27	21	6
8		Fortaleza	29	20	8	5	7	22	19	3
9		Cuiabá	28	20	8	4	8	21	23	-2
10		São Paulo	28	20	7	7	6	24	19	5
11		Atlético Mineiro	27	20	7	6	7	22	18	4
12		Cruzeiro	25	20	6	7	7	20	17	3
13		Corinthians	24	19	6	6	7	21	22	-1
14		Internacional	24	20	6	6	8	17	24	-7
15		Goiás	23	20	6	5	9	19	28	-9
16		Bahia	21	20	5	6	9	22	25	-3
17		Santos	21	20	5	6	9	21	32	-11
18		Vasco da Gama	16	19	4	4	11	15	29	-14
19		Coritiba	14	20	3	5	12	20	39	-19
20		América (MG)	10	19	2	4	13	20	44	-24

gt::gtsave(act, paste(folder, current_date, ' - Tabela HOJE.png', sep = ''), expand = 60)
gt::gtsave(sim, paste(folder, current_date, ' - Tabela FINAL.png', sep = ''), expand = 60)